COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	EXPR CHART() 
C00008 00003	EXPR INIT() 
C00011 ENDMK
C⊗;
EXPR CHART() ;
BEGIN
NEW NAME, YEAR, MONTH, DAY, HOUR, ZONE, LATITUDE, LONGITUDE,
    STDTIME, W, GMT, SIDTIMENOON, SIDTIMEG, SIDTIME, SDAY, SGMT,
    SMALLT, BIGT, CUSPS, PNEXT, PNATAL, PPREV, MC, ASC, S ;
IF NULL('JANUARY.MONTH) THEN INIT() ;
CHOICE(10) ;

PRINTSTR("IN CASE OF TYPO, MAKE NEXT RESPONSE `NIL'") ;
NAME ← RD("NAME") ;
YEAR ← RD("YEAR") ;
DO BEGIN MONTH ← RD("MONTH") ;
   IF NOT NUMBERP MONTH THEN MONTH ← MONTH.MONTH ;
   END
UNTIL NUMBERP MONTH ;
DAY ← RD("DAY OF THE MONTH") ;
HOUR ← RD("TIME, E.G., 1745 FOR 5:45PM") ;
DO	BEGIN
	ZONE ← RD("TIME ZONE, E.G., (PACIFIC DAYLIGHT WAR)") ;
	W ← (CAR ZONE).WESTOFGREENWICH ;
	IF NOT NUMBERP W THEN PRINTSTR("NO SUCH ZONE " CAT CAR(ZONE)) ;
	END UNTIL NUMBERP W ;
LATITUDE ← RD("LATITUDE, DEGREES NORTH") ;
LONGITUDE ← RD("LONGITUDE, DEGREES WEST") ;
TERPRI PRINC(<NAME, HOUR, <DAY, MONTHS[MONTH], YEAR>, ZONE,
   LATITUDE, 'N, LONGITUDE, 'W>) ;
%MINUTES AFTER MIDNIGHT FROM HERE ON, EXCEPT SECONDS FOR SIDEREAL TIME%
STDTIME ← MINS(HOUR) - ZONECORRECTION(ZONE) ;
GMT ← STDTIME + 60*W ;
TERPRI PRINC(<'GMT, CLOCK(GMT)>) ;
CHOICE(3) ;

SDAY ← IF GMT GREATERP 24*60 THEN DAY+1 ELSE DAY ;
SGMT ← IF GMT GREATERP 24*60 THEN GMT-24*60 ELSE GMT ;
PRINTSTR("GIVE SIDEREAL TIMES IN THE FORM 174552 FOR 17:45:52") ;
SIDTIMENOON ←
	SECS(RD("SIDEREAL TIME NOON FOR " CAT YEAR CAT MONTHS[MONTH] CAT SDAY)) ;
SIDTIMEG ← SIDTIMENOON + (361*(SGMT-12*60))/6 ;
SIDTIME ← REMAINDER(SIDTIMEG - 240*LONGITUDE + 48*3600, 24*3600) ;
PRINTSTR("LOOK IN THE TABLE OF HOUSES, LATITUDE "
   CAT LATITUDE CAT " N SIDER'L TIMES NEAR " CAT
   SCLOCK(SIDTIME)) ;
CUSPS ← FOR NEW SIDT IN '(SMALLER LARGER) COLLECT
	<SECS(RD("NEXT " CAT SIDT CAT " SIDEREAL TIME")) CONS
	  FOR NEW HOUSE IN HOUSES COLLECT
		<<IF SIDT EQ 'SMALLER THEN
			DO CSIGN ← RD("SIGN AT " CAT HOUSE CAT " CUSP")
			UNTIL CSIGN.SIGN,
		  RD("DEGREES"), RD("MINUTES")>>
	> ;
SDAY ← IF GMT LESSP 12*60 THEN DAY-1 ELSE DAY ;
PRINTSTR("NOW TURN TO THE EPHEMERIS FOR " CAT YEAR CAT
   MONTHS[MONTH] CAT SDAY) ;

FOR NEW D ← 1 TO 3 DO
BEGIN
IF D=3 THEN S←RD("TYPE OUTPUT FILENAME OR TTY (OR NIL)") ALSO
	BEGIN IF S NEQ 'TTY THEN EVAL(<'OUTC,<'OUTPUT,'DSK?:,S>>) END
ELSE CHOICE(3) ;
PRINTSTR(CASE D OF BEGIN
   "ENTER NOON POSITIONS OF THE PLANETS (FOR PLUTO, 1ST OF MONTH)";
   "DO THE SAME FOR " CAT MONTHS[MONTH] CAT (SDAY+1);
   "HERE ARE THE NATAL POSITIONS"
   END) ;
FOR NEW P IN '(SUN VENUS MERCURY MOON SATURN JUPITER MARS URANUS
   NEPTUNE PLUTO) DO
   CASE D OF
   BEGIN
   P.PREV ← <DO S←RD(P CAT " SIGN") UNTIL S.SIGN,
      RD("DEGREES"), RD("MINUTES")> ;
   P.NEXT ← <S←CAR(P.PREV),
      RD("DEGREES OF " CAT S CAT " FOR " CAT P), RD("MINUTES")> ;
	BEGIN
	PNEXT ← P.NEXT ; PPREV ← P.PREV ;
	PNATAL ←
	   IF P EQ 'PLUTO THEN INTERP(SDAY, 1, 60*PPREV[2]+PPREV[3],
		LASTDAY[MONTH]+1, 60*PNEXT[2]+PNEXT[3])
	   ELSE INTERP(GMT,
	   	IF GMT LESSP 12*60 THEN -12*60 ELSE 12*60, 60*PPREV[2]+PPREV[3],
		IF GMT LESSP 12*60 THEN 12*60 ELSE 36*60, 60*PNEXT[2]+PNEXT[3]) ;
	TERPRI PRINC(<P, ARC(PNATAL), PPREV[1]>) ;
	END ;
   END ;
END ;
SMALLT ← CAR(CUSPS[1]) ; BIGT ← CAR(CUSPS[2]) ;
FOR NEW SMALL	IN CDR(CUSPS[1])
FOR NEW BIG	IN CDR(CUSPS[2])
FOR NEW HOUSE	IN HOUSES
    DO	BEGIN
	C ← INTERP(SIDTIME, SMALLT, SMALL[2]*60+SMALL[3], BIGT, BIG[2]*60+BIG[3]) ;
	TERPRI PRINC(<HOUSE, ARC(C), SMALL[1]>) ;
	END ;
TERPRI PRINC(NAME) ;
OUTC(NIL,T);
RD("TYPE `NIL' TO MAKE CORRECTIONS NOW") ;
END ;
EXPR INIT() ;
BEGIN

FOR NEW I ← 4 TO 8 FOR NEW Z IN '(ATLANTIC EASTERN
   CENTRAL MOUNTAIN PACIFIC) DO
   Z.WESTOFGREENWICH ← I ;

FOR NEW I ← 1 TO 12 FOR NEW S IN '(ARIES TAURUS GEMINI
   CANCER LEO VIRGO LIBRA SCORPIO SAGITTARIUS CAPRICORN AQUARIUS
   PISCES) DO
   S.SIGN ← I ;

FOR NEW I ← 1 TO 12 FOR NEW M IN '((JANUARY JAN)(FEBRUARY FEB)
   (MARCH MAR) (APRIL APR) (MAY) (JUNE) (JULY) (AUGUST AUG)
   (SEPTEMBER SEP) (OCTOBER OCT) (NOVEMBER NOV) (DECEMBER DEC))
	DO FOR NEW MM IN M DO MM.MONTH ← I ;

MONTHS ← <" JANUARY ", " FEBRUARY ", " MARCH ", " APRIL ", " MAY ",
	  " JUNE ", " JULY ", " AUGUST ", " SEPTEMBER ", " OCTOBER ",
	  " NOVEMBER ", " DECEMBER "> ;
LASTDAY ← '(31 28 31 30 31 30 31 31 30 31 30 31) ;

HOUSES ← '(?10TH ?11TH ?12TH ASC ?2ND ?3RD) ;

END ;

EXPR INTERP(KEY, PREKEY, PREVAL, POSTKEY, POSTVAL) ;
   ((POSTVAL-PREVAL)*(KEY-PREKEY))/(POSTKEY-PREKEY) + PREVAL ;

EXPR RD(N) ;
   BEGIN
   NEW RDVAL ;
   PRINTSTR(N CAT " = ") ;
   RDVAL ← READ() ;
   IF ¬RDVAL THEN DDPNT() ALSO FAILURE() ;
   RETURN RDVAL ;
   END ;

EXPR ZONECORRECTION(Z) ;
   60*((IF 'DAYLIGHT MEMQ Z THEN 1 ELSE 0)
      +(IF 'WAR MEMQ Z THEN 1 ELSE 0)) ;

EXPR MINS(HR) ; 60*QUOTIENT(HR,100) + REMAINDER(HR,100) ;

EXPR SECS(HR) ; 3600*QUOTIENT(HR,10000) + MINS(REMAINDER(HR,10000)) ;

EXPR CLOCK(MS) ; 100*QUOTIENT(MS,60) + REMAINDER(MS,60) ;

EXPR SCLOCK(SS) ; 10000*QUOTIENT(SS,3600) + CLOCK(REMAINDER(SS,3600)) ;

EXPR ARC(MS) ; (QUOTIENT(MS,60)) CAT "⊗ " CAT REMAINDER(MS,60) CAT "'" ;

EXPR CHOICE(N) ;
   SELECT II FROM II:1 SUCCESSOR II+1 UNLESS II GREATERP N FINALLY FAILURE() ;

_EOF_